Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/mssghkct/systray.frm

Visual Basic Form | 1998-11-20 | 5.2 KB | 167 lines

VERSION 4.00
Begin VB.Form frmSysTray
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "SysTray"
   ClientHeight    =   2385
   ClientLeft      =   2820
   ClientTop       =   3555
   ClientWidth     =   4110
   Height          =   2790
   Icon            =   "SysTray.frx":0000
   Left            =   2760
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2385
   ScaleWidth      =   4110
   ShowInTaskbar   =   0   'False
   Top             =   3210
   Width           =   4230
   Begin VB.Label Label2
      BackStyle       =   0  'Transparent
      Caption         =   "Copyright
 1998, Alex Wainstein"
      Height          =   240
      Left            =   60
      TabIndex        =   3
      Top             =   810
      Width           =   3210
   End
   Begin VB.Label lblMailTo
      BackStyle       =   0  'Transparent
      Caption         =   "[e-mail]"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   177
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   240
      Left            =   645
      MouseIcon       =   "SysTray.frx":014A
      MousePointer    =   99  'Custom
      TabIndex        =   2
      Top             =   1080
      Width           =   1875
   End
   Begin VB.Label Label4
      BackStyle       =   0  'Transparent
      Caption         =   "e-mail:"
      Height          =   210
      Left            =   75
      TabIndex        =   1
      Top             =   1080
      Width           =   510
   End
   Begin VB.Label Label1
      Caption         =   "This sample uses Message Hook control to create a taskbar tray notification area icon and handle all mouse events."
      Height          =   675
      Left            =   90
      TabIndex        =   0
      Top             =   90
      Width           =   3945
   End
   Begin MSGHOOKLibCtl.MsgHook MsgHook1
      Left            =   2340
      OleObjectBlob   =   "SysTray.frx":029C
      Top             =   1830
   End
   Begin VB.Menu mnuBar
      Caption         =   "Menu"
      Visible         =   0   'False
      Begin VB.Menu mnuShow
         Caption         =   "&Show"
      End
      Begin VB.Menu mnuExit
         Caption         =   "E&xit"
      End
      Begin VB.Menu mnuSep1
         Caption         =   "-"
      End
      Begin VB.Menu mnuAbout
         Caption         =   "&About"
      End
   End
Attribute VB_Name = "frmSysTray"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' See Global.bas for the global declarations
Dim t As NOTIFYICONDATA
Private bExit As Boolean
Private Sub Form_Load()
'1. Add icon to the system tray
    t.cbSize = Len(t)
    t.hwnd = Me.hwnd
    t.uId = 1&
    t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    t.ucallbackMessage = WM_TRAYNOTIFY
    t.hIcon = Me.Icon
    t.szTip = "Message Hook!" & Chr$(0)
    Shell_NotifyIcon NIM_ADD, t
    App.TaskVisible = False
'2. Set MsgHook to handle WM_TRAYNOTIFY message for this window
MsgHook1.hwnd = hwnd
MsgHook1.AddMessage WM_TRAYNOTIFY, mshEatMessage 'mshPostProcess
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
' If closed from system menu or 'x' button - just hide
If UnloadMode = vbFormControlMenu And Not bExit Then
    Cancel = True
    Hide
End If
'else close
End Sub
Private Sub Form_Unload(Cancel As Integer)
    t.cbSize = Len(t)
    t.hwnd = Me.hwnd
    t.uId = 1&
    t.uFlags = 0&
    Shell_NotifyIcon NIM_DELETE, t
End Sub
Private Sub lblMailTo_Click()
Dim res As Long
Dim lpOperation As String
Dim lpFile As String
Dim lpParameters As String
Dim lpDirectory As String
Dim nShowCmd As Long
lpOperation = "open"
lpFile = "MAILTO:" + lblMailTo
nShowCmd = vbNormalFocus
res = ShellExecute(hwnd, lpOperation, lpFile, lpParameters, ByVal lpDirectory, nShowCmd)
End Sub
Private Sub mnuAbout_Click()
    frmAbout.Show vbModal
End Sub
Private Sub mnuExit_Click()
' We cannot simply call Unload Me because we need
' to let Message Hook to complete window message processing
' BEFORE the window is destroyed, but Unload Me does SendMessage
' We need to use PostMessage:
bExit = True
PostMessage MsgHook1.hwnd, WM_CLOSE, 0&, 0&
End Sub
Private Sub mnuShow_Click()
    Me.Show
End Sub
Private Sub MsgHook1_Message(ByVal MsgId As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal MsgProcessing As Integer, MsgResult As Long)
Select Case MsgId
Case WM_TRAYNOTIFY:
       Select Case lParam
            Case WM_LBUTTONDBLCLK:
            Case WM_LBUTTONDOWN:
            Case WM_LBUTTONUP:
                    mnuShow_Click
            Case WM_RBUTTONDBLCLK:
            Case WM_RBUTTONDOWN:
            Case WM_RBUTTONUP:
                PopupMenu mnuBar, , , , mnuShow ' This may invoke mnuExit_Click
        End Select
End Select
End Sub